home *** CD-ROM | disk | FTP | other *** search
/ Deutsche Edition 1 / Deutsche Edition 1.iso / amok / 051-060 / amok58 / textwindows / textwindows.mod < prev    next >
Text File  |  1993-11-04  |  6KB  |  259 lines
  1. (*************************************************************************
  2.  
  3. :Program.       TextWindows.mod
  4. :Contents.      IO for mutilible Windows
  5. :Author.        Hartmut Goebel
  6. :Language.      Oberon
  7. :Translator.    Amiga Oberon V1.17.1
  8. :History.       V1.0, 23 May 1991, Hartmut Goebel
  9. :Update.        ReadHex now also accepts lower-case charakters
  10. :Date.          23 May 1991 15:13:37
  11.  
  12. :Support.       most parts were taken form Oberon-Std-Module 'io'
  13. :Imports.       Printf (Volker Rudolph)
  14.  
  15. :Remark.        Works just like 'io', but you must specify the window
  16. :Remark.        where the action should take place
  17. :Usage.         'OpenTextWin()' -  perform io -  'CloseTextWin()'
  18.  
  19. *************************************************************************)
  20.  
  21. MODULE TextWindows;
  22.  
  23. (* $OvflChk- $RangeChk- (*$StackChk-*) $NilChk- $ReturnChk- $CaseChk- *)
  24.  
  25. IMPORT
  26.   asc: ASCII,
  27.   e: Exec,
  28.   d: Dos,
  29.   prtf: Printf,
  30.   lst: Lists,
  31.   sys: SYSTEM;
  32.  
  33. TYPE
  34.   TxtWinPtr*= POINTER TO TxtWin;
  35.   TxtWin = RECORD (lst.Node)
  36.     handle: d.FileHandlePtr;
  37.   END;
  38.   String = ARRAY 40 OF CHAR;
  39.  
  40. VAR
  41.   WinList: lst.List;
  42.   (*n: lst.NodePtr;*)
  43.   n: TxtWinPtr;
  44.   sptr: POINTER TO String;
  45.   l: LONGINT;
  46.  
  47.   ftemp: ARRAY 80 OF CHAR; (* schön lang! *)
  48.   helpstr: String;
  49.  
  50.  
  51. (*-----------------------------------------------------------------------*)
  52.  
  53. PROCEDURE OpenTextWin*(title: ARRAY OF CHAR;
  54.                        x,y,w,h: INTEGER): TxtWinPtr;
  55. VAR
  56.   tw: TxtWinPtr;
  57. BEGIN
  58.   NEW(tw);
  59.   IF tw=NIL THEN RETURN NIL END; (* $NilChk- *)
  60.   prtf.SPrintf5(ftemp,"CON:%ld/%ld/%ld/%ld/%s",x,y,w,h,sys.ADR(title));
  61.   tw.handle := d.Open(ftemp,d.newFile);
  62.   IF tw.handle = NIL THEN DISPOSE(tw); RETURN NIL; END;
  63.   lst.AddTail(WinList,tw);
  64.   RETURN tw;         (* $NilChk= *)
  65. END OpenTextWin;
  66.  
  67.  
  68. PROCEDURE CloseTextWin*(VAR tw: TxtWinPtr);
  69. BEGIN
  70.   lst.Remove(WinList,tw);
  71.   d.Close(tw.handle);
  72.   DISPOSE(tw);  (* => tw := NIL *)
  73. END CloseTextWin;
  74.  
  75. (*-----------------------------------------------------------------------*)
  76.  
  77.  
  78. PROCEDURE * RFProc; (* $EntryExitCode- *)
  79. BEGIN
  80.   sys.INLINE(016C0U,  (* MOVE.B D0,(A3)+ *)
  81.              04E75U); (* RTS             *)
  82. END RFProc;
  83.  
  84. (*-------------------------------------------------------------------------*)
  85.  
  86.  
  87. PROCEDURE Length*(str: ARRAY OF CHAR): INTEGER; (* $EntryExitCode- *)
  88. BEGIN
  89. sys.INLINE(02C5FH,        (*      move.l  (sp)+,a6  *)
  90.          0301FH,          (*      move.w  (sp)+,d0  *)
  91.          0205FH,          (*      move.l  (sp)+,a0  *)
  92.          05340H,          (*      subq    #1,d0     *)
  93.          03200H,          (*      move.w  d0,d1     *)
  94.          04A18H,          (* l:   tst.b   (a0)+     *)
  95.          057C9H, 0FFFCH,  (*      dbeq    d1,l      *)
  96.          09041H,          (*      sub.w   d1,d0     *)
  97.          04ED6H);         (*      jmp     (a6)      *)
  98. END Length;
  99.  
  100.  
  101. (*-------------------------------------------------------------------------*)
  102.  
  103.  
  104. PROCEDURE Write*(tw: TxtWinPtr; ch: CHAR);
  105. BEGIN sys.SETREG(0,d.Write(tw.handle,ch,1)) END Write;
  106.  
  107.  
  108. PROCEDURE WriteLn*(tw: TxtWinPtr);
  109. BEGIN Write(tw,"\n") END WriteLn;
  110.  
  111.  
  112. PROCEDURE WriteString*(tw: TxtWinPtr; str: ARRAY OF CHAR); (* $CopyArrays- *)
  113. BEGIN sys.SETREG(0,d.Write(tw.handle,str,Length(str))) END WriteString;
  114.  
  115.  
  116. PROCEDURE Tab*(tw: TxtWinPtr; n: INTEGER);
  117. VAR s: ARRAY 80 OF CHAR;
  118.     i: INTEGER;
  119. BEGIN
  120.   WHILE n>0 DO
  121.     i := 0;
  122.     REPEAT
  123.       s[i] := " ";
  124.       INC(i);
  125.     UNTIL (i=79) OR (i=n);
  126.     DEC(n,i);
  127.     s[i] := 0X;
  128.     WriteString(tw,s);
  129.   END;
  130. END Tab;
  131.  
  132.  
  133. PROCEDURE Clear*(tw: TxtWinPtr);
  134. BEGIN Write(tw,"\f") END Clear;
  135.  
  136.  
  137. (*-------------------------------------------------------------------------*)
  138.  
  139.  
  140. PROCEDURE Format*(tw: TxtWinPtr; VAR str: String; data:LONGINT);
  141. (* %% => %
  142.      links  führ.0   min.max Breite  longdata   dez|hex|string|char
  143.    %  [-]    [0]      [123 [.123] ]     [l]        (d|x|s|c)
  144.  
  145.    Char ist immer in WORD, auch bei Angabe 'l'!!!
  146.    String-Adresse ist immer LONG!!!
  147. *)
  148. (* niemals mehr als 79 Zeichen erzeugen! *)
  149. BEGIN
  150.   e.RawDoFmt(str,data,RFProc,sys.ADR(ftemp));
  151.   WriteString(tw,ftemp);
  152. END Format;
  153.  
  154.  
  155. (*-------------------------------------------------------------------------*)
  156.  
  157.  
  158. PROCEDURE WriteInt*(tw: TxtWinPtr; x: LONGINT; n: INTEGER);
  159. BEGIN
  160.   e.RawDoFmt('%%%dld',sys.ADR(n),RFProc,sys.ADR(helpstr));
  161.   Format(tw,helpstr,sys.ADR(x));
  162. END WriteInt;
  163.  
  164.  
  165. PROCEDURE WriteHex*(tw: TxtWinPtr; x: LONGINT; n: INTEGER);
  166. BEGIN
  167.   IF n>=0 THEN (* RawDoFmt spinnt etwas bei neg. Zahlen und führ. 0 *)
  168.     e.RawDoFmt('%%0%dlx',sys.ADR(n),RFProc,sys.ADR(helpstr));
  169.   ELSE
  170.     n:=-n;
  171.     e.RawDoFmt('%%-%dlx',sys.ADR(n),RFProc,sys.ADR(helpstr));
  172.   END;
  173.   Format(tw,helpstr,sys.ADR(x));
  174. END WriteHex;
  175.  
  176. (*-------------------------------------------------------------------------*)
  177.  
  178. PROCEDURE Read*(tw: TxtWinPtr; VAR ch: CHAR);
  179. BEGIN IF d.Read(tw.handle,ch,1)#1 THEN ch := asc.eof END;
  180. END Read;
  181.  
  182. PROCEDURE ReadString*(tw: TxtWinPtr; VAR str: ARRAY OF CHAR);
  183. VAR i: INTEGER;
  184. BEGIN
  185.   i := 0;
  186.   REPEAT
  187.     Read(tw,str[i]);
  188.     CASE str[i] OF "\n",asc.eof,0X: str[i] := 0X; RETURN ELSE END;
  189.     INC(i);
  190.   UNTIL i=LEN(str);
  191. END ReadString;
  192.  
  193.  
  194. PROCEDURE ReadInt*(tw: TxtWinPtr; VAR x: LONGINT): BOOLEAN;
  195. VAR
  196.   ch: CHAR;
  197.   d: LONGINT;
  198.   neg: BOOLEAN;
  199.   str: String;
  200.   i: INTEGER;
  201. BEGIN
  202.   x := 0; i := 0;
  203.   ReadString(tw,str);
  204.   neg := FALSE;
  205.   IF str[0]="-" THEN neg := TRUE; i := 1 END;
  206.   LOOP
  207.     ch := str[i];
  208.     CASE ch OF
  209.     0X: IF neg THEN x := -x END; RETURN TRUE |
  210.     "0".."9":
  211.       d := ORD(ch)-ORD("0");
  212.       IF (MAX(LONGINT)-d) DIV 10 >= x THEN x := 10*x+d ELSE EXIT END |
  213.     ELSE EXIT END;
  214.     INC(i);
  215.   END;
  216.   RETURN FALSE;
  217. END ReadInt;
  218.  
  219.  
  220. PROCEDURE ReadHex*(tw: TxtWinPtr; VAR x: LONGINT): BOOLEAN;
  221. VAR
  222.   ch: CHAR;
  223.   d: LONGINT;
  224.   str: String;
  225.   i: INTEGER;
  226. BEGIN
  227.   x := 0; i := 0;
  228.   ReadString(tw,str);
  229.   LOOP
  230.     ch := str[i];
  231.     CASE ch OF
  232.     0X:       RETURN TRUE |
  233.     "0".."9": DEC(ch,ORD("0")) |
  234.     "A".."F": DEC(ch,ORD("A")-10) |
  235.     "a".."f": DEC(ch,ORD("a")-10) |
  236.     ELSE EXIT END;
  237.     d := ORD(ch);
  238.     IF (MAX(LONGINT)-d) DIV 16 >= x THEN x := 16*x+d ELSE EXIT END;
  239.     INC(i);
  240.   END;
  241.   RETURN FALSE;
  242. END ReadHex;
  243.  
  244. (*-------------------------------------------------------------------------*)
  245.  
  246. BEGIN
  247.   lst.Init(WinList);
  248.  
  249. CLOSE
  250.   LOOP
  251.     n := sys.VAL(TxtWinPtr,lst.Head(WinList));
  252.     IF n = NIL THEN EXIT END;
  253.     CloseTextWin(n);
  254.   END;
  255.  
  256. END TextWindows.
  257.  
  258.  
  259.